home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / rulers1 / rulers.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-22  |  3KB  |  147 lines
  1. unit Rulers;
  2. {By Bill Murto, 73730,2505 No Copyright. Free. Enjoy.}
  3.  
  4. interface
  5.  
  6. uses
  7.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  8.   Forms;
  9.  
  10. type
  11.   THRuler = class(TGraphicControl)
  12.   private
  13.     { Private declarations }
  14.     fHRulerAlign: TAlign;
  15.     procedure SetHRulerAlign(Value: TAlign);
  16.   protected
  17.     { Protected declarations }
  18.     procedure Paint; override;
  19.   public
  20.     { Public declarations }
  21.     constructor Create(AOwner: TComponent); override;
  22.   published
  23.     { Published declarations }
  24.     property AlignHRuler: TAlign read fHRulerAlign write SetHRulerAlign default alNone;
  25.     property Color default clYellow;
  26.     property Height default 33;
  27.     property Width default 768;
  28.     property Visible;
  29.   end;
  30.  
  31.   type
  32.   TVRuler = class(TGraphicControl)
  33.   private
  34.     { Private declarations }
  35.     fVRulerAlign: TAlign;
  36.     procedure SetVRulerAlign(Value: TAlign);
  37.   protected
  38.     { Protected declarations }
  39.     procedure Paint; override;
  40.   public
  41.     { Public declarations }
  42.     constructor Create(AOwner: TComponent); override;
  43.   published
  44.     { Published declarations }
  45.     property AlignVRuler: TAlign read fVRulerAlign write SetVRulerAlign default alNone;
  46.     property Color default clYellow;
  47.     property Height default 1008;
  48.     property Width default 33;
  49.     property Visible;
  50.   end;
  51.  
  52. procedure Register;
  53.  
  54. implementation
  55.  
  56. procedure Register;
  57. begin
  58.   RegisterComponents('Samples', [THRuler, TVRuler]);
  59. end;
  60.  
  61. procedure THRuler.SetHRulerAlign(Value: TAlign);
  62. begin
  63.   if Value in [alTop, alBottom, alNone] then
  64.   begin
  65.     fHRulerAlign := Value;
  66.     Align := Value;
  67.   end;
  68. end;
  69.  
  70. constructor THRuler.Create(AOwner: TComponent);
  71. begin
  72.   inherited Create(AOwner);
  73.   AlignHRuler := alNone;
  74.   Color := clYellow;
  75.   Height := 33;
  76.   Width := 768;
  77. end;
  78.  
  79. procedure THRuler.Paint;
  80. var a12th, N, X : word;
  81. begin
  82.   a12th := Screen.PixelsPerInch div 12;
  83.   N := 0; X := 0;
  84.   with Canvas do
  85.   begin
  86.     Brush.Color := Color;
  87.     FillRect(ClientRect);
  88.     with ClientRect do
  89.       Rectangle(Left, Top, Right, Bottom);
  90.     while X < Width do
  91.     begin
  92.       MoveTo(X, 1);
  93.       LineTo(X, 6*(1 + byte(N mod 3 = 0) +
  94.         byte(N mod 6 = 0) +
  95.         byte(N mod 12 = 0)));
  96.       if (N > 0) and (N mod 12 = 0) then
  97.         TextOut(PenPos.X+3, 9, IntToStr(N div 12));
  98.       N := N + 1;
  99.       X := X + a12th;
  100.     end;
  101.   end;
  102. end;
  103. {*********************************************}
  104. procedure TVRuler.SetVRulerAlign(Value: TAlign);
  105. begin
  106.   if Value in [alLeft, alRight, alNone] then
  107.   begin
  108.     fVRulerAlign := Value;
  109.     Align := Value;
  110.   end;
  111. end;
  112.  
  113. constructor TVRuler.Create(AOwner: TComponent);
  114. begin
  115.   inherited Create(AOwner);
  116.   AlignVRuler := alNone;
  117.   Color := clYellow;
  118.   Height := 1008;
  119.   Width := 33;
  120. end;
  121.  
  122. procedure TVRuler.Paint;
  123. var a6th, N, Y : word;
  124. begin
  125.   a6th := Screen.PixelsPerInch div 6;
  126.   N := 0; Y := 0;
  127.   with Canvas do
  128.   begin
  129.     Brush.Color := Color;
  130.     FillRect(ClientRect);
  131.     with ClientRect do
  132.       Rectangle(Left, Top, Right, Bottom);
  133.     while Y < Height do
  134.     begin
  135.       MoveTo(1, Y);
  136.       LineTo(6*(2 + byte(N mod 3 = 0) +
  137.         byte(N mod 6 = 0)),Y);
  138.       if (N > 0) and (N mod 6 = 0) then
  139.         TextOut(12, PenPos.Y-16, IntToStr(N div 6));
  140.       N := N + 1;
  141.       Y := Y + a6th;
  142.     end;
  143.   end;
  144. end;
  145.  
  146. end.
  147.